home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok71.lha / TurboFilesV2.1 / TurboFiles.mod < prev    next >
Text File  |  1993-08-15  |  11KB  |  407 lines
  1.  
  2. (**********************************************************************
  3.  
  4.     :Program.    (Turbo)Files
  5.     :Contents.   Module for filehandling, like FileSystem
  6.     :Author.     Stefan Salewski
  7.     :Address.    Stefan Salewski, Stolper Weg 3, D-2160 Stade
  8.     :Copyright.  FD
  9.     :Language.   Oberon/68000-Assembler
  10.     :Translator. Amiga-Oberon-Compiler V2.14 and A68k
  11.     :History.    V2.0     12-06-91 (on Amok#56)
  12.     :History.    V2.1     23.02.92 some changes for Oberon V2.14
  13.     :Remark.     The modules Files and TurboFiles does the same, but
  14.     :Remark.     TurboFiles is quicker, because the important
  15.     :Remark.     Procedures are coded in Assembler.
  16.     :Remark.     Link from CLI: OLink MyProgram OBJ TurboFiles.o
  17.     :Remark.     or use JOIN to merge TurboFiles.obj(s) and TurboFiles.o
  18.     :Remark.     The assemblerpart and documentation is on Amok#56
  19.  
  20. **********************************************************************)
  21.  
  22. (* Changes for Oberon V2.14d:
  23.    Define a new datatype: "TYPE Address=LONGINT"
  24.    and replace "Exec.ADDRESS" with "Address"
  25.    Replace in the procedure Open() "VAR buf:Address"
  26.    with "VAR buf:SYSTEM.ADDRESS"
  27.    Replace in the procedure Open() "f.top:=buf+bufferSize;"
  28.    with "f.top:=SYSTEM.VAL(LONGINT,buf)+bufferSize;"
  29.    In the procedure Close() insert "VAR h:SYSTEM.ADDRESS" and replace
  30.    "OberonLib.Dispose(f.base);"
  31.    with "h:=f.base; OberonLib.Dispose(h);"
  32.    In the procedure Code() replace
  33.    "CopyMem(SYSTEM.ADR(code),SYSTEM.ADR(code)+cWLen,cWLen);" with
  34.    "CopyMem(SYSTEM.ADR(code),SYSTEM.VAL(LONGINT,SYSTEM.ADR(code))+cWLen,cWLen);"
  35.    Replace "VAR DosBase:Address" with "VAR DosBase:SYSTEM.ADDRESS"
  36.  *)
  37.  
  38. MODULE TurboFiles;
  39.   IMPORT SYSTEM,
  40.          OberonLib,
  41.          Dos,
  42.          SecureDos,
  43.          Exec,
  44.          Random,
  45.          ASCII,
  46.          Strings;
  47.  
  48.   CONST
  49.     D0= 0; D1= 1;
  50.     A0= 8; A1= 9;
  51.  
  52.   CONST
  53.     newFile* = TRUE;    (* open new file (delete old one) for read/write *)
  54.     oldFile* = FALSE;   (* open existing file for read/write *)
  55.  
  56.   CONST (* Error-Codes = file.res *)
  57.     done*         = 0;
  58.     notdone*      = 1;
  59.     notOpen*      = 2;
  60.     openError*    = 3;
  61.     readError*    = 4;
  62.     writeError*   = 5;
  63.     seekError*    = 6;
  64.     endOfFile*    = 7;
  65.     outOfMem*     = 8;
  66.     notExists*    = 9;
  67.  
  68.   CONST (* Modes for SetPos *)
  69.     beginning* = Dos.beginning;
  70.     current*   = Dos.current;
  71.     end*       = Dos.end;
  72.  
  73.   TYPE
  74.     Address=LONGINT;
  75.     File* = RECORD
  76.               fhPtr:Dos.FileHandlePtr;
  77.               dosBase:Address;
  78.               base:Address;
  79.               top:Address;
  80.               filePos:LONGINT;
  81.               startLength:LONGINT;
  82.               act:Address;
  83.               readTop:Address;
  84.               writeBase:Address;
  85.               writeTop:Address;
  86.               open:BOOLEAN;
  87.               res*:SHORTINT;
  88.            END;
  89.  
  90.   VAR
  91.     DosBase:SYSTEM.ADDRESS;
  92.     ExecBase[4]:Address;
  93.  
  94.   PROCEDURE CopyMem{ExecBase,-624}(source{8}:Address;
  95.                                    dest{9}:Address;
  96.                                    size{0}:LONGINT);
  97.  
  98.   PROCEDURE DosRead{DosBase,-42}(file{1}:Dos.FileHandlePtr;
  99.                                  buffer{2}:Address;
  100.                                  length{3}:LONGINT):LONGINT;
  101.  
  102.   PROCEDURE DosWrite{DosBase,-48}(file{1}:Dos.FileHandlePtr;
  103.                                   buffer{2}:Address;
  104.                                   length{3}:LONGINT):LONGINT;
  105.  
  106.   PROCEDURE DeleteFile*{DosBase,-72}(name{1}:ARRAY OF CHAR):BOOLEAN;
  107.  
  108.   PROCEDURE ReadChar*{"TurboReadChar"}
  109.                      (VAR f{A0}:File;VAR c{A1}:BYTE):BOOLEAN;
  110.  
  111.   PROCEDURE ReadBytes*{"TurboReadBytes"}
  112.                       (VAR f{A0}:File;adr{A1}:Address;
  113.                        len{D1}:LONGINT):LONGINT;
  114.  
  115.   PROCEDURE Read*{"TurboRead"}
  116.                  (VAR f:File;VAR to:ARRAY OF BYTE):BOOLEAN;
  117.  
  118.   PROCEDURE WriteChar*{"TurboWriteChar"}
  119.                       (VAR f{A0}:File;c{D1}:BYTE):BOOLEAN;
  120.  
  121.   PROCEDURE WriteBytes*{"TurboWriteBytes"}
  122.                        (VAR f{A0}:File;adr{A1}:Address;
  123.                         len{D1}:LONGINT):BOOLEAN;
  124.  
  125.   PROCEDURE Write*{"TurboWrite"}
  126.                   (VAR f:File;from:ARRAY OF BYTE):BOOLEAN;
  127.  
  128.   PROCEDURE Size*{"TurboSize"}
  129.                  (VAR f{A0}:File):LONGINT;
  130.  
  131.   PROCEDURE GetPos*{"TurboGetPos"}
  132.                    (VAR f{A0}:File):LONGINT;
  133.  
  134.   PROCEDURE SetPos*{"TurboSetPos"}
  135.                    (VAR f{A0}:File;offset{D0}:LONGINT;
  136.                     mode{D1}:LONGINT):BOOLEAN;
  137.  
  138.   PROCEDURE MinLongInt(i,j:LONGINT):LONGINT;
  139.   BEGIN
  140.     IF i<j THEN RETURN i ELSE RETURN j END;
  141.   END MinLongInt;
  142.  
  143.   PROCEDURE Exists*(name: ARRAY OF CHAR;VAR size:LONGINT):BOOLEAN;
  144.   (* $CopyArrays- *)
  145.     VAR
  146.       flPtr:Dos.FileLockPtr;
  147.       (* info:Dos.FileInfoBlock; must be on a 4 byte boundary !!! *)
  148.       infoPtr:Dos.FileInfoBlockPtr;
  149.       exists:BOOLEAN;
  150.   BEGIN
  151.     exists:=FALSE;
  152.     size:=0;
  153.     flPtr:=SecureDos.Lock(name,Dos.sharedLock);
  154.     IF flPtr#NIL THEN
  155.       NEW(infoPtr);
  156.       IF infoPtr#NIL THEN
  157.         IF Dos.Examine(flPtr,infoPtr^) THEN
  158.           exists:=TRUE;
  159.           IF infoPtr.dirEntryType<0 THEN (* is a file *)
  160.             size:=infoPtr.size;
  161.           ELSE
  162.             size:=-1                  (* is a directory *)
  163.           END;
  164.         END;
  165.         DISPOSE(infoPtr);
  166.       END;
  167.       SecureDos.UnLock(flPtr);
  168.     END;
  169.     RETURN exists
  170.   END Exists;
  171.  
  172.   PROCEDURE Open*(VAR f:File;name:ARRAY OF CHAR;
  173.                   bufferSize:LONGINT;new:BOOLEAN):BOOLEAN;
  174.   (* $CopyArrays- *)
  175.     VAR
  176.       buf:SYSTEM.ADDRESS;
  177.       mode:LONGINT;
  178.   BEGIN
  179.     f.open:=FALSE;
  180.     IF new THEN
  181.       f.startLength:=0;
  182.       mode:=Dos.newFile
  183.     ELSE
  184.       mode:=Dos.oldFile;
  185.       IF NOT Exists(name,f.startLength) OR (f.startLength<0) THEN
  186.         f.res:=notExists;
  187.         RETURN FALSE
  188.       END;
  189.     END;
  190.     IF bufferSize<1 THEN bufferSize:=1 END;
  191.     OberonLib.New(buf,bufferSize);
  192.     IF buf=NIL THEN
  193.       f.res:=outOfMem;
  194.       RETURN FALSE
  195.     END;
  196.     f.fhPtr:=SecureDos.Open(name,mode);
  197.     IF f.fhPtr=NIL THEN
  198.       OberonLib.Dispose(buf);
  199.       f.res:=openError;
  200.       RETURN FALSE
  201.     ELSE
  202.       f.dosBase:=DosBase;
  203.       f.filePos:=0;
  204.       f.base:=buf;
  205.       f.top:=SYSTEM.VAL(LONGINT,buf)+bufferSize;
  206.       f.act:=buf;
  207.       f.readTop:=buf;
  208.       f.writeTop:=buf;
  209.       f.writeBase:=f.top;
  210.       f.open:=TRUE;
  211.       f.res:=done;
  212.       RETURN TRUE;
  213.     END;
  214.   END Open;
  215.  
  216.   PROCEDURE Close*(VAR f:File):BOOLEAN;
  217.     VAR h:SYSTEM.ADDRESS;
  218.   BEGIN
  219.     IF (NOT f.open) OR (f.res=notOpen) THEN RETURN FALSE END;
  220.     IF f.writeTop>f.writeBase THEN
  221.       IF Dos.Seek(f.fhPtr,f.writeBase-f.readTop,Dos.current) > 0 THEN END;
  222.       IF DosWrite(f.fhPtr,f.writeBase,f.writeTop-f.writeBase)> 0 THEN END;
  223.     END;
  224.     SecureDos.Close(f.fhPtr);
  225.     h:=f.base;
  226.     OberonLib.Dispose(h);
  227.     f.open:=FALSE;
  228.     f.res:=notOpen;
  229.     RETURN TRUE;
  230.   END Close;
  231.  
  232.   PROCEDURE ReadString*(VAR f:File;VAR str:ARRAY OF CHAR):INTEGER;
  233.     VAR i:INTEGER;
  234.   BEGIN
  235.     i:=-1;
  236.     LOOP
  237.       INC(i);
  238.       IF i=LEN(str) THEN EXIT END;
  239.       IF NOT ReadChar(f,str[i]) THEN EXIT END;
  240.       IF (str[i]=ASCII.nul) OR (str[i]=ASCII.eol) THEN EXIT END;
  241.     END;
  242.     IF i<LEN(str) THEN str[i]:=0X END;
  243.     RETURN i
  244.   END ReadString;
  245.  
  246.   PROCEDURE WriteString*(VAR f:File;str:ARRAY OF CHAR):BOOLEAN;
  247.   (* CopyArrays- *)
  248.     VAR i:INTEGER;
  249.   BEGIN
  250.     i:=0;
  251.     WHILE (i<LEN(str)) AND (str[i]#0X) DO
  252.       IF WriteChar(f,str[i]) THEN END;
  253.       INC(i);
  254.     END;
  255.     RETURN f.res=done;
  256.   END WriteString;
  257.  
  258.   PROCEDURE WriteLn*(VAR f:File):BOOLEAN;
  259.   BEGIN
  260.     RETURN WriteChar(f,ASCII.lf);
  261.   END WriteLn;
  262.  
  263.   PROCEDURE Search*(VAR f:File;str:ARRAY OF BYTE;len:INTEGER):LONGINT;
  264.   (* $CopyArrays- *)
  265.   VAR
  266.     i:INTEGER;
  267.     b:BYTE;
  268.   BEGIN
  269.     IF NOT (f.open) OR (f.res#done) THEN RETURN -1 END;
  270.     IF (len>LEN(str)) OR (len<=0) THEN
  271.       len:=LEN(str)
  272.     END;
  273.     DEC(len);
  274.     LOOP
  275.       i:=0;
  276.       LOOP
  277.         IF NOT ReadChar(f,b) THEN RETURN -1 END;
  278.         IF (b#str[i]) OR (i=len) THEN
  279.           EXIT
  280.         END;
  281.         INC(i);
  282.       END;
  283.       IF (str[i]=b) AND SetPos(f,-i-1,current) THEN
  284.         RETURN GetPos(f)
  285.       ELSIF (i>0) THEN
  286.        IF SetPos(f,-i,current) THEN END;
  287.       END;
  288.     END;
  289.   END Search;
  290.  
  291.   PROCEDURE Code*(fileName,codeWord:ARRAY OF CHAR;decode:BOOLEAN):BOOLEAN;
  292.   (* $CopyArrays- *)
  293.     CONST
  294.       Mult=2;
  295.       CodeStringSize=127;
  296.       BufferSize=1024;
  297.     TYPE
  298.       CodeString=ARRAY CodeStringSize OF SHORTINT;
  299.  
  300.     VAR
  301.       act,i:LONGINT;
  302.       cWLen:LONGINT;
  303.       f:File;
  304.       eof:BOOLEAN;
  305.       code,readPuffer,writePuffer,index:CodeString;
  306.  
  307.     PROCEDURE Permute(VAR index,code:CodeString;len:SHORTINT);
  308.     VAR
  309.       qsum:LONGINT;
  310.       i,h,rnd:SHORTINT;
  311.     BEGIN
  312.       (* generating a permutation of the numbers 0..(len-1).
  313.          This permutation depends on code and will be
  314.          stored in index
  315.       *)
  316.       qsum:=0;
  317.       i:=0;
  318.       WHILE i<len DO
  319.         INC(qsum,code[i]);
  320.         index[i]:=i;
  321.         INC(i);
  322.       END;
  323.       Random.PutSeed(qsum);
  324.       i:=0;
  325.       WHILE i<len DO
  326.         rnd:=SHORT(Random.RND(len));
  327.         h:=index[i];
  328.         index[i]:=index[rnd];
  329.         index[rnd]:=h;
  330.         INC(i);
  331.       END;
  332.     END Permute;
  333.  
  334.   BEGIN
  335.     cWLen:=MinLongInt(Strings.Length(codeWord),CodeStringSize);
  336.     CopyMem(SYSTEM.ADR(codeWord),SYSTEM.ADR(code),cWLen);
  337.     IF cWLen<=0 THEN
  338.       RETURN FALSE
  339.     END;
  340.     IF Open(f,fileName,BufferSize,oldFile) THEN
  341.       WHILE cWLen < (CodeStringSize DIV 2) DO
  342.         CopyMem(SYSTEM.ADR(code),SYSTEM.VAL(LONGINT,SYSTEM.ADR(code))+cWLen,cWLen);
  343.         INC(cWLen,cWLen);
  344.       END;
  345.       Permute(index,code,SHORT(SHORT(cWLen)));
  346.       i:=0;
  347.       WHILE i<cWLen DO
  348.         (* $OvflChk- *)
  349.         code[i]:=code[i]*Mult;
  350.         (* $OvflChk= *)
  351.         INC(i);
  352.       END;
  353.       eof:=FALSE;
  354.       WHILE NOT eof DO
  355.         act:=ReadBytes(f,SYSTEM.ADR(readPuffer),cWLen);
  356.         IF act<cWLen THEN
  357.           eof:=TRUE;
  358.           f.res:=done; (* So I can write to the file again *)
  359.           Permute(index,code,SHORT(SHORT(act)))
  360.         END;
  361.         IF NOT decode THEN
  362.           i:=0;
  363.           WHILE i<act DO
  364.             (* $OvflChk- *)
  365.             INC(readPuffer[i],code[i]);
  366.             (* $OvflChk= *)
  367.             INC(i);
  368.           END;
  369.           i:=0;
  370.           WHILE i<act DO
  371.             writePuffer[i]:=readPuffer[index[i]];
  372.             INC(i);
  373.           END;
  374.         ELSE
  375.           i:=0;
  376.           WHILE i<act DO
  377.             writePuffer[index[i]]:=readPuffer[i];
  378.             INC(i);
  379.           END;
  380.           i:=0;
  381.           WHILE i<act DO
  382.             (* $OvflChk- *)
  383.             DEC(writePuffer[i],code[i]);
  384.             (* $OvflChk= *)
  385.             INC(i);
  386.           END;
  387.         END;
  388.         IF SetPos(f,-act,current) THEN END;
  389.         IF WriteBytes(f,SYSTEM.ADR(writePuffer),act) THEN END;
  390.       END;
  391.       IF Close(f) THEN END;
  392.       RETURN TRUE
  393.     ELSE
  394.       RETURN FALSE
  395.     END;
  396.   END Code;
  397.  
  398. BEGIN
  399.   DosBase:=Dos.dos;
  400.   IF DosBase=NIL THEN HALT(0) END;
  401.  
  402. END TurboFiles.
  403.  
  404.  
  405.  
  406.  
  407.